procedure ShowTime(nPixels, startTicks: integer); var time: real; cr: string; begin time := (TickCount - StartTicks) / 60; cr := chr(13); PutMessage(nPixels:1, ' pixels', cr, time:1:2, ' seconds', cr, nPixels/time:1:0, ' pixels/second'); end; macro 'Fast Invert'; var width, height, StartTicks: integer; begin GetPicSize(width,height); StartTicks := TickCount; Invert; ShowTime(width*height, StartTicks); end; macro 'Slow Invert'; { This macro illustrates why it's not a good idea to use macros for pixel-by-pixel processing. } var width,height,value,x,y,StartTicks: integer; begin GetPicSize(width,height); if width = 0 then begin beep; PutMessage('Image required.'); exit; end; StartTicks := TickCount; for y:=0 to height-1 do begin GetRow(0,y,width); for x:=0 to width-1 do LineBuffer[x]:=255-LineBuffer[x]; PutRow(0,y,width); end; ShowTime(width*height, StartTicks); end; macro 'Real Slow Invert'; { This macro illustrates why it's better to use GetRow and PutRow instead of GetPixel and PutPixel. } var width,height,value,x,y,StartTicks: integer; begin GetPicSize(width,height); if width = 0 then begin beep; PutMessage('Image required.'); exit; end; StartTicks := TickCount; for y:=0 to height-1 do for x:=0 to width-1 do PutPixel(x, y, 255-GetPixel(x,y)); ShowTime(width*height, StartTicks); end; macro '(---'; begin end; macro 'Show Status [S]'; var roiType: integer; begin NewTextWindow('Status'); writeln('MaxMeasuements = ', Get('MaxMeasurements'):1); writeln('UndoBufSize = ', Get('UndoBufSize')/1024:1,'K'); writeln('FreeMem = ', Get('FreeMem')/1024:1,'K'); writeln('MaxBlock = ', Get('MaxBlock')/1024:1,'K'); roiType := Get('RoiType'); write('RoiType: '); if roiType = 0 then write('No ROI or no image') else if roiType = 1 then write('rectangle') else if roiType = 2 then write('ellipse') else if roiType = 3 then write('polygon') else if roiType = 4 then write('freehand') else if roiType = 5 then write('traced') else if roiType = 6 then write('straight line') else if roiType = 7 then write('freehand line') else if roiType = 8 then write('segmented line'); end macro 'Draw Vertical Calibration Bar'; var left,top,width,height,i,x,y2,inc:integer; y:real; begin GetRoi(left,top,width,height); if width=0 then begin beep; PutMessage('Make a rectangular selection first.'); exit; end; SetFont('Helvetica'); SetFontSize(10); SetText('Plain; Left; no background'); SetLineWidth(1); Setforeground(255); DrawScale; x:=left; y:=top; inc:=height/10; for i:=1 to 11 do begin MoveTo(x+width+10,round(y)+2); y2:=round(y); if i=11 then y2:=y2-1; write(cvalue(GetPixel(x,y2)):1:2); y:=y+inc; end; end; macro 'ASCII Dump'; { Generates an alphanumeric listing of pixels values starting at the upper left corner of the current selection. 20 rows and 44 columns can be displayed with the default 552 x 436 window. } var image,dump,roiLeft,roiTop,roiWidth,roiHeight:integer; h,v,value,MaxWidth,MaxHeight,width,height:integer; begin image:=PicNumber; GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight); if roiWidth=0 then begin beep; PutMessage('This macro requires a rectangular selection.'); exit; end; SetForegroundColor(255); SetBackgroundColor(0); MakeNewWindow('ASCII Dump'); dump:=PicNumber; GetPicSize(width,height); MaxWidth:=width div 24 - 2; MaxHeight:=height div 9 - 3; if roiWidth>MaxWidth then roiWidth:=MaxWidth; if roiHeight>MaxHeight then roiHeight:=MaxHeight; SetFont('Monaco'); SetFontSize(9); SetText('With background; Left Justified'); MoveTo(2,12); write(' '); for h:=roiLeft to roiLeft+roiWidth-1 do write(h:4); writeln; writeln; for v:=roiTop to roiTop+roiHeight-1 do begin write(v:3,' '); for h:=roiLeft to roiLeft+roiWidth-1 do begin ChoosePic(image); value:=GetPixel(h,v); ChoosePic(dump); write(value:4); end; writeln; end; ChoosePic(image); end; macro 'Scale and Rotate All'; { Resizes and/or rotates all currently open widows. For example, change the ScaleAndRotate command below to ScaleAndRotate(2,2,0) to change the size of all the images in a movie loop sequence from 128 x 128 to 256 x 256. } var i:integer; begin SaveState; SetScaling('Bilinear; Create New Window'); for i:=1 to nPics do begin ChoosePic(1); ScaleAndRotate(1.9,1.9,0); ChoosePic(1); Close; end; for i:=1 to nPics do begin ChoosePic(i); SetPicName(i); end; RestoreState; end; macro 'Dispose All'; begin DisposeAll; end; macro 'Average two Images'; {Generates the arithmetic average of two images.} begin RequiresVersion(1.53); if nPics<>2 then begin PutMessage('This macro requires exactly two image windows to be open.'); Exit; End; ImageMath('add' ,1 ,2, 0.5, 0, 'Average'); end; macro 'Make Montage [M]'; {Opens a new window and creates in it a composite image made from all} {currently open images. All the images must be the same size.} var width,height,w,h,mWidth,mHeight,nWindows,left,top:integer; RoiWidth,RoiHeight,RoiWidth,RoiHeight,i,hloc,vloc:integer; montage,temp:integer; scale:real; SameSize:boolean; begin nWindows:=nPics; SameSize:=true; GetPicSize(width,height); for i:=1 to nPics do begin SelectPic(i); GetPicSize(w,h); SameSize:=SameSize and (w=width) and (h=height); end; if (nWindows<2) or not SameSize then begin PutMessage('This macro needs two or more images of the same size in order to create a montage.'); Exit; end; SetBackground(0); MakeNewWindow('Montage'); montage:=nWindows+1; GetPicSize(mWidth,mHeight); SelectPic(1); Duplicate('Temp'); temp:=nWindows+2; scale:=GetNumber('Scaling Factor:',0.25); hloc:=-(RoiWidth); vloc:=0; for i:=1 to nWindows do begin SelectPic(i); SelectAll; copy; SelectPic(temp); paste; SelectAll; ScaleSelection(scale,scale); RestoreRoi; if i=1 then begin GetRoi(left,top,RoiWidth,RoiHeight); hloc:=-RoiWidth; vloc:=0; end; Copy; SelectPic(montage); hloc:=hloc+RoiWidth; if (hloc+RoiWidth)>mWidth then begin hloc:=0; vloc:=vloc+RoiHeight; end; MakeRoi(hloc,vloc,RoiWidth,RoiHeight); Paste; end; KillRoi; SelectPic(temp); Dispose; end; macro 'Make Sine Wave'; var left,top,width,height,i:integer; ppp,scale:real; begin SaveState; MakeNewWindow('Sine Wave'); SelectAll; GetRoi(left,top,Width,Height); if width=0 then begin PutMessage('This macro requires a rectangular selection.'); Exit; end; ppp:=GetNumber('Pixels per period',100); Scale:=ppp/6.28; MakeRoi(left,top,1,height); for i:=1 to width do begin SetForeground(sin(i/scale)*127 +128); {SetForeground((sin(i/scale)*127 +128)*(i+30)/(width));} {SetForeground(sin(i/(ppp*((width-i+3)/width)/6.28))*127 +128);} fill; MoveRoi(1,0); end; KillRoi; RestoreState; end; macro 'Beep if No Selection [B]'; var left,top,width,height:integer; begin GetRoi(left,top,width,height); if width=0 then beep; end; macro 'Exponent DemoÉ'; var base,ex, result:real; begin base:=GetNumber('Base:', 2); ex:=GetNumber('Exponent:', 5); result:=exp(ln(base)*ex); PutMessage(result:6:3); end; macro 'Convert Number to String TestÉ'; var n: real; s1, s2, s3, s4: string; begin n:=GetNumber('Enter a Number', 12.345); s1 := concat(n); s2 := concat(n:1:2); s3 := concat(n:10:4); s4 := concat(n:0); PutMessage('s1=',s1,', s2=',s2,', s3=',s3', s4=',s4); end; macro '(---'; begin end; {These macros allow you to easily switch} {transfer modes while pasting by tapping keys.} macro 'Copy Mode[1]'; begin SetOption; DoCopy; end; macro 'AND Mode[2]'; begin SetOption; DoAnd; end; macro 'OR Mode [3]'; begin SetOption; DoOr; end; macro 'XOR Mode[4]'; begin SetOption; DoXor; end; macro 'REPLACE Mode[5]'; begin SetOption; DoReplace; end; macro 'BLEND [6]'; begin SetOption; DoBlend; end; macro 'Terminate Paste [7]'; begin KillRoi end;